## Words norm - for valence computation:
warriner_path <- "wordstim/allwrdnorms_warriner.csv" # columns: word, valence, arousal, dominance - will be used as valence indicates the average valence rating on a 9-point scale from 1 (very positive) to 9 (very negative), obtained from Warriner and colleagues (2013) Macho-Nice Guy Dichotomy
1 HistWords repo
For our purposes, I use the same approach chosen by Tessa E. S. Charlesworth and colleagues—namely, the HistWords repository, which is available on GitHub.
1.0.1 What’s going on?
HistWords is an open-source dataset and toolkit that provides word embeddings for different historical periods, trained on Google Books Ngram (and other corpora). Each decade (1800–1990) has its own 300-dimensional vector space representing the meaning of words in that era.
Think of it as a longitudinal semantic dataset—rather than tracking people over time, we track words across decades. Each vector encodes a word’s position in the shared “meaning space” of its time.
1.0.1.1 What can we do with it?
Inspect meaning: find the nearest neighbors of a word in any decade.
Compare meanings over time: compute cosine similarity for the same word across decades to track semantic drift.
Study cultural change: analyze how a word’s associations (e.g., macho, nice) evolve by decade.
Compose phrases: average vectors (e.g., macho + guy) to represent multi-word concepts.
Align embeddings: apply sequential Procrustes alignment to make spaces from different decades comparable.
1.0.2 What are we comparing?
In this project, I adopt an approach similar to Tessa et al. designed to avoid the alignment problem inherent in diachronic word embeddings—which makes direct comparison of raw cosine similarities between two embedding spaces (e.g., the 1910s and the 1920s) invalid.
Instead of directly comparing raw cosine similarities of words across decades, I examine within-decade associations—for example, comparing how strongly macho and nice are each associated with the words in a given decade.
The difference between these associations is then converted into a standardized effect size, which serves as the unit of comparison across time. This method lets me trace semantic or attitudinal change without requiring the embedding spaces to be aligned.
Across time (overall)—I identify the top 10 and top 50 word and trait associates that are most strongly (and relatively) associated with one type of man (and least with the comparison group) by:
computing cosine similarity of all words and traits to each type in each decade (e.g., the cosine similarities of all traits to macho man in 1800). After inspecting distances, I test whether there is a significant difference between the two types—i.e., whether the descriptors are semantically distinct from those of nice guy—as a sanity check; and
calculating the difference in MAC scores; Macho (MAC) − Nice (MAC) identifies words/traits most associated with Macho, and reversing the subtraction captures the opposite pattern. In short, across time, which words and traits are most associated with Macho/Nice Guy?
Across time (by decade)—I examine the top trait and word associates for each decade:
compute decade-specific cosine-similarity difference scores and rank words and traits within each decade; and
compute the average, decade-wise valence of the top associates by averaging ratings of those words’ positivity/negativity in each of the 20 decades.
Nevertheless, following Tessa et al.’s guidance, applying orthogonal Procrustes rotation can still be useful as a robustness check or for future extensions involving cross-decade word-trajectory analyses.
The following code is written using the ds4psych: Data Science for Psychology: Natural Language workflow (https://ds4psych.com). Therefore, the toolset used here differs from Tessa’s.
Notably, in the 2000s there was a change in N-gram sampling. Therefore, embeddings using the corpus from the 2000s onward are excluded.
As an alternative, we might consider NRC VAD (S. M. Mohammad, 2018), which contains 20,007 words with ratings between 0 and 1 for valence, arousal, and dominance.
## List of traits:
traits_path <- "wordstim/traitlist.txt"
# We would latter on create a file storing those words for the code to be more elegant :
nice_guy_words <- c(
"kind", "gentle", "caring", "sensitive", "considerate", "respectful",
"supportive", "understanding", "emotional", "warm", "affectionate",
"polite", "reliable", "faithful", "honest", "loyal", "thoughtful",
"attentive", "humble", "nice","whipped", "romantic"
)
macho_guy_words <- c(
"dominant", "assertive", "confident", "tough", "strong", "decisive",
"bold", "powerful", "competitive", "aggressive", "independent", "unemotional",
"fearless","alpha", "leader", "charismatic", "commanding", "cocky", "ambitious", "macho"
)1.0.3 Pay attention!
To ensure that words are embedded in the context of masculine traits, I examine two approaches. The first is to inject male anchors. This should help position each word group within a masculine semantic field rather than in a generic trait context (traits that could appear in feminine contexts as well). This is implemented in the Concepts chunk.
- Cons / watch-outs:
Anchor dominance risk—male anchors can outweigh trait terms if the lists are small. Moreover, shared anchors in both groups reduce the distance between group centroids (smaller margins).
Monitor: anchor share in each centroid (≤30–40%), cosine margin between group means, and Top-N stability across decades (overlap %).
The second approach, implemented in the next Helpers chunk, is a masculinity projection nudge. I construct a male–female axis and then “masculinize” any term by nudging it toward the male direction before scoring. This gently steers polysemous words toward the male sense without hard-wiring “man” as a single axis for all items.
- Cons / watch-outs:
Axis quality—if the gender sets are unbalanced or drift strongly by decade, the direction can be noisy.
Leakage—over-weighting (large w) can wash out original semantics.
Monitor: axis stability across decades (cosine between decade-specific dmale), use small w (e.g., 0.1–0.3) and run sensitivity analyses; compare results with and without the tweak.
A comparison of both techniques is needed to validate results and serve as a robustness check.
# --- 1) Small helpers ---------------------------------------
# Read a single decade embedding file into a matrix with rownames = words
read_embeddings <- function(path) {
# HistWords format: first line header with counts; thereafter: word + 300 dims
raw <- vroom(path, col_names = FALSE, progress = FALSE, delim = " ")
# Some files include the first line as counts; detect and drop if so
if (nchar(raw$X1[1]) > 0 && !is.na(as.numeric(raw$X1[1]))) {
# first line looks numeric -> drop it
raw <- raw[-1, ]
}
words <- raw$X1
M <- as.matrix(raw[,-1])
rownames(M) <- words
storage.mode(M) <- "double"
M
}1.0.4 Masculinity projection nudge
As noted earlier, to interpret traits within a masculine frame, we apply a Masculinity Nudge: we construct a female–male axis in the embedding space and add a small component of this axis to each construct vector, gently shifting it toward the male semantic field so that subsequent comparisons reflect the words’ masculine sense.
# E: numeric matrix (rows = tokens, cols = dims),
# rownames(E) are tokens - We should make sure that out embedding model's architecture is built in this manner.
# male_tokens / female_tokens: anchors for the axis (can leave defaults)
male_anchors <- c("man","men","male","guy") #Question: should we add 'boy'?
female_anchors <- c("woman", "women", "female","girl")
build_male_female_axis <- function(E, male_tokens, female_tokens) {
avail <- rownames(E)
m <- intersect(tolower(male_tokens), avail)
f <- intersect(tolower(female_tokens), avail)
if (length(m) == 0 || length(f) == 0)
stop("Insufficient anchors to build gender axis.")
male_mu <- colMeans(E[m, , drop = FALSE])
female_mu <- colMeans(E[f, , drop = FALSE])
axis <- male_mu - female_mu
axis / sqrt(sum(axis * axis)) # we want the gender axis to represent direction only, not magnitude. this normalization step is meant to make the axis to be of a unit length
}
# DDR-based masculinity function:
# w = nudge strength (0 = no nudge, >0 = push toward masculine direction)
# default is set to 1 to inteperate results easily and to make sure that the wors be are assigning is regards to word_GUY not that word in general
masculinity_nudge <- function(ddr_vec, # Or any dim1:dim300 embedding object
E, # The embedding space
male_tokens = male_anchors,
female_tokens = female_anchors,
w = 1) {
# ensure DDR is a numeric vector
if (is.matrix(ddr_vec)) ddr_vec <- as.numeric(ddr_vec)
axis <- build_male_female_axis(E, male_tokens, female_tokens)
ddr_vec <- ddr_vec / sqrt(sum(ddr_vec * ddr_vec))
# apply nudge: shift toward masculine axis
ddr_vec_nudged <- ddr_vec + w * axis
#re normalize - Consult Almog if necessary
ddr_vec_nudged <- ddr_vec_nudged / sqrt(sum(ddr_vec_nudged * ddr_vec_nudged))
ddr_vec_nudged
}
# From df to embedding Object function- to fit 'embedplyr' workflow:
to_embeddings <- function(df){
# keep available rows, ensure rownames are tokens
stopifnot(is.data.frame(df), !is.null(rownames(df)))
# Keep only available words -
keep <- df$V1 != 0
M <- as.matrix(df[keep, , drop = FALSE])
# give it the right class so embedplyr methods (predict/emb/find_nearest) work
class(M) <- c("embeddings", class(M))
attr(M, "normalized") <- FALSE # optional meta; not required
# crucial: token_index environment (token -> row index) - since the words are stored as rownames
idx_env <- new.env(parent = emptyenv())
toks <- rownames(M)
for (j in seq_along(toks)) assign(toks[j], j, envir = idx_env)
attr(M, "token_index") <- idx_env
M
}The second approach—the Inject approach—as noted above, adds male anchor words to the word banks so that the average embedding of each list is drawn toward a masculine context.
1.0.5 ENGall Model
Properties of ENGall_model:
- n of words: 100,000 (same word list across all decades). the authors only computed embeddings for words that were among the top 100,000 most frequent words over all time (for EngAll)
- n of dimensions: 300.
- Type of Embedding : SGNS.
- Context Window : symmetric context window of 4 words.
## ----------- ENGall model -----------
load(ENGall_dir)
#the load(ENGall_dir) creates an 'wordvecs.dat' object of which I want to store in more intuituve object name
ENGall_model <- wordvecs.dat
length(ENGall_model)[1] 20
The ENGall model provides embeddings for the 100,000 most frequent words across all time. This means words coined later in history will be missing in earlier slices, and some words will be absent in particular decade models. The model is stored as a list of 20 elements, one per decade. In some decade data frames, certain words have no embedding.
let’s map those words.
#### ---- Check unavailable words by decade ----
n_avwords <- vector()
n_unav<- vector()
prop_avail <- vector()
n_total <- vector()
# Creating a list of available word and unavailable words:
for (i in seq_along(ENGall_model)) {
# Count available words as those with V1 != 0
n_avwords[i] <- sum(ENGall_model[[i]]$V1 != 0)
n_total[i] <- ENGall_model[[i]]|>
nrow()
n_unav[i] <- n_total[i] - n_avwords[i]
prop_avail[i] <- n_avwords[i] / n_total[i]
}
avwords_n_decade_df <- data.frame(
decade = decades,
n_avwords = n_avwords,
n_unavwords = n_unav,
prop_avail = prop_avail
)kable(avwords_n_decade_df |>
#adding comma
mutate(across(where(is.numeric),scales::comma)),
digits = 3,
caption = "Proportion of Words with Embedding")| decade | n_avwords | n_unavwords | prop_avail |
|---|---|---|---|
| 1,800 | 13,045 | 86,955 | 0.1304 |
| 1,810 | 15,771 | 84,229 | 0.1577 |
| 1,820 | 20,312 | 79,688 | 0.2031 |
| 1,830 | 21,691 | 78,309 | 0.2169 |
| 1,840 | 23,818 | 76,182 | 0.2382 |
| 1,850 | 29,035 | 70,965 | 0.2904 |
| 1,860 | 27,191 | 72,809 | 0.2719 |
| 1,870 | 29,320 | 70,680 | 0.2932 |
| 1,880 | 34,081 | 65,919 | 0.3408 |
| 1,890 | 37,729 | 62,271 | 0.3773 |
| 1,900 | 41,551 | 58,449 | 0.4155 |
| 1,910 | 36,553 | 63,447 | 0.3655 |
| 1,920 | 35,643 | 64,357 | 0.3564 |
| 1,930 | 34,477 | 65,523 | 0.3448 |
| 1,940 | 34,226 | 65,774 | 0.3423 |
| 1,950 | 41,807 | 58,193 | 0.4181 |
| 1,960 | 54,332 | 45,668 | 0.5433 |
| 1,970 | 60,344 | 39,656 | 0.6034 |
| 1,980 | 64,934 | 35,066 | 0.6493 |
| 1,990 | 71,097 | 28,903 | 0.7110 |
Out of 100,000 words, each decade has on average 36,347 available words.
Notably, the 1990s slice has ~71% of words available. This does not mean “29% are post-1990 words.” Rather, 29% of the top-100k (over 1800–1999) simply lack enough occurrences in the 1990s to train vectors—often because they are earlier-era words that faded out, or because they are rare or orthographically different in that decade.
Later, we will pull valence from Warriner’s list (~14,000 words), which bounds our effective vocabulary to those items. Because not all Warriner words appear in ENGall, the intersection may be smaller.
Another concern is whether some of the words used to define our constructs are missing from the model.
Let’s check!
### ---- Check if macho/nice words by decade -------
# 1) Availability (token x decade)
avail <- map2_df(ENGall_model, decades, ~
tibble(
decade = .y,
token = tolower(rownames(.x)),
available = .x$V1 != 0
)
)
# Define the sets you care about
sets <- list(
macho = macho_guy_words,
nice = nice_guy_words,
male = male_anchors
)
wanted <- enframe(sets, name = "set", value = "token") |>
unnest(token) |>
mutate(token = tolower(token))
# proportion per decade + list of missing words
macho_nice_words_by_decade_df <- wanted |>
left_join(avail, by = "token") |>
mutate(available = tidyr::replace_na(available, FALSE)) |>
group_by(set, decade) |>
summarise(
n_of_words_examined = n(),
n_available = sum(available),
prop_avail = n_available / n_of_words_examined,
missing = list(token[!available]),
.groups = "drop"
) |>
arrange(set, decade)kable(macho_nice_words_by_decade_df,
caption= "Construct's word presence across time")| set | decade | n_of_words_examined | n_available | prop_avail | missing |
|---|---|---|---|---|---|
| macho | 1800 | 20 | 10 | 0.5000000 | dominant , assertive , competitive, aggressive , unemotional, fearless , alpha , charismatic, cocky , macho |
| macho | 1810 | 20 | 12 | 0.6000000 | dominant , assertive , competitive, aggressive , unemotional, charismatic, cocky , macho |
| macho | 1820 | 20 | 12 | 0.6000000 | dominant , assertive , competitive, aggressive , unemotional, charismatic, cocky , macho |
| macho | 1830 | 20 | 13 | 0.6500000 | assertive , competitive, aggressive , unemotional, charismatic, cocky , macho |
| macho | 1840 | 20 | 13 | 0.6500000 | assertive , competitive, aggressive , unemotional, charismatic, cocky , macho |
| macho | 1850 | 20 | 14 | 0.7000000 | assertive , competitive, unemotional, charismatic, cocky , macho |
| macho | 1860 | 20 | 14 | 0.7000000 | assertive , competitive, unemotional, charismatic, cocky , macho |
| macho | 1870 | 20 | 15 | 0.7500000 | assertive , unemotional, charismatic, cocky , macho |
| macho | 1880 | 20 | 15 | 0.7500000 | assertive , unemotional, charismatic, cocky , macho |
| macho | 1890 | 20 | 15 | 0.7500000 | assertive , unemotional, charismatic, cocky , macho |
| macho | 1900 | 20 | 16 | 0.8000000 | unemotional, charismatic, cocky , macho |
| macho | 1910 | 20 | 16 | 0.8000000 | unemotional, charismatic, cocky , macho |
| macho | 1920 | 20 | 16 | 0.8000000 | unemotional, charismatic, cocky , macho |
| macho | 1930 | 20 | 16 | 0.8000000 | unemotional, charismatic, cocky , macho |
| macho | 1940 | 20 | 16 | 0.8000000 | unemotional, charismatic, cocky , macho |
| macho | 1950 | 20 | 16 | 0.8000000 | unemotional, charismatic, cocky , macho |
| macho | 1960 | 20 | 17 | 0.8500000 | unemotional, cocky , macho |
| macho | 1970 | 20 | 17 | 0.8500000 | unemotional, cocky , macho |
| macho | 1980 | 20 | 20 | 1.0000000 | |
| macho | 1990 | 20 | 20 | 1.0000000 | |
| male | 1800 | 5 | 5 | 1.0000000 | |
| male | 1810 | 5 | 5 | 1.0000000 | |
| male | 1820 | 5 | 5 | 1.0000000 | |
| male | 1830 | 5 | 5 | 1.0000000 | |
| male | 1840 | 5 | 5 | 1.0000000 | |
| male | 1850 | 5 | 5 | 1.0000000 | |
| male | 1860 | 5 | 5 | 1.0000000 | |
| male | 1870 | 5 | 5 | 1.0000000 | |
| male | 1880 | 5 | 5 | 1.0000000 | |
| male | 1890 | 5 | 5 | 1.0000000 | |
| male | 1900 | 5 | 5 | 1.0000000 | |
| male | 1910 | 5 | 5 | 1.0000000 | |
| male | 1920 | 5 | 5 | 1.0000000 | |
| male | 1930 | 5 | 5 | 1.0000000 | |
| male | 1940 | 5 | 5 | 1.0000000 | |
| male | 1950 | 5 | 5 | 1.0000000 | |
| male | 1960 | 5 | 5 | 1.0000000 | |
| male | 1970 | 5 | 5 | 1.0000000 | |
| male | 1980 | 5 | 5 | 1.0000000 | |
| male | 1990 | 5 | 5 | 1.0000000 | |
| nice | 1800 | 22 | 15 | 0.6818182 | caring , sensitive , considerate, supportive , emotional , reliable , thoughtful |
| nice | 1810 | 22 | 18 | 0.8181818 | caring , supportive, emotional , reliable |
| nice | 1820 | 22 | 19 | 0.8636364 | supportive, emotional , reliable |
| nice | 1830 | 22 | 19 | 0.8636364 | supportive, emotional , reliable |
| nice | 1840 | 22 | 20 | 0.9090909 | supportive, emotional |
| nice | 1850 | 22 | 21 | 0.9545455 | supportive |
| nice | 1860 | 22 | 21 | 0.9545455 | supportive |
| nice | 1870 | 22 | 21 | 0.9545455 | supportive |
| nice | 1880 | 22 | 21 | 0.9545455 | supportive |
| nice | 1890 | 22 | 21 | 0.9545455 | supportive |
| nice | 1900 | 22 | 21 | 0.9545455 | supportive |
| nice | 1910 | 22 | 21 | 0.9545455 | supportive |
| nice | 1920 | 22 | 21 | 0.9545455 | supportive |
| nice | 1930 | 22 | 21 | 0.9545455 | supportive |
| nice | 1940 | 22 | 21 | 0.9545455 | supportive |
| nice | 1950 | 22 | 22 | 1.0000000 | |
| nice | 1960 | 22 | 22 | 1.0000000 | |
| nice | 1970 | 22 | 22 | 1.0000000 | |
| nice | 1980 | 22 | 22 | 1.0000000 | |
| nice | 1990 | 22 | 22 | 1.0000000 |
It seems the words cocky and macho do not appear in ENGall at all. I therefore omit them to avoid adding noise.
(Consult with Almog about the unequal lengths of the nice vs. macho lists after omission: length(nice) = 22; length(macho) = 18.)
length(macho_guy_words)[1] 20
#[1] 20
length(macho_guy_words_injected)[1] 25
#[1] 25
length(male_anchors)[1] 5
# [1] 5
macho_guy_words <- setdiff(macho_guy_words,c("cocky", "macho"))
macho_guy_words_injected <- setdiff(macho_guy_words_injected,c("cocky", "macho"))
# Sanity check
length(macho_guy_words)[1] 18
# [1] 18
length(macho_guy_words_injected)[1] 23
# [1] 23
# OK I'm sane2 DDR
Now I will create the Macho and Nice guy contracts (DDR). Currently the Engall[[i]] (the model of a specific decade) is of type df while predict() function expects an embedding object that way we would use the to_embedding() helper:
# ---- setting the ENGall model to fit 'embedplyr' workflow
## ----------- Macho DDR (with injection) ----------
Macho_DDR_injected_by_decade <- list()
for (i in seq_along(ENGall_model)) {
# Getting the prediction of embedding DDR of the Macho_guy words (with injection) while converting the ENGall model to ebedding object:
Macho_DDR_injected_by_decade[[i]] <- predict(to_embeddings(ENGall_model[[i]]), macho_guy_words_injected)|>
#I'll average the embedding inside the loop since each DDR embedding is computed on it's on corpus/decade- noteworthy the averages is done by Google Trillion Word corpus which meant to weight words base on their frequency.
# Consult with Almog - should the weighting be done by our model of choice (ENGall) setting anchor="good"?
average_embedding()
}
# Make it more readable:
names(Macho_DDR_injected_by_decade) <- decades
## ----------- Nice DDR (with injection) ----------
# Follow the same process as before
Nice_DDR_injected_by_decade <- list()
for (i in seq_along(ENGall_model)) {
Nice_DDR_injected_by_decade[[i]] <- predict(to_embeddings(ENGall_model[[i]]), nice_guy_words_injected)|>
average_embedding()
}
# Make it more readable:
names(Nice_DDR_injected_by_decade) <- decades
#----------- The 'Nudge Appraoch' -------------
## ----------- Macho DDR Nudge ----------
# Follow the same process as before
Macho_DDR_nudge_by_decade <- list()
for (i in seq_along(ENGall_model)) {
Macho_DDR_nudge_by_decade[[i]] <- predict(to_embeddings(ENGall_model[[i]]), macho_guy_words)|>
average_embedding() |>
# Same as before but now I'll apply the nudge toward the masculine direction
masculinity_nudge(E = ENGall_model[[i]])
}
names(Macho_DDR_nudge_by_decade) <- decades
## ----------- Nice DDR Nudge ----------
Nice_DDR_nudge_by_decade <- list()
for (i in seq_along(ENGall_model)) {
Nice_DDR_nudge_by_decade[[i]] <- predict(to_embeddings(ENGall_model[[i]]), nice_guy_words)|>
average_embedding() |>
# Same as before but now I'll apply the nudge toward the masculine direction
masculinity_nudge(E = ENGall_model[[i]])
}
names(Nice_DDR_nudge_by_decade) <- decades2.1 Cos Sims
DDRs are just points in semantic space. Next, I compute the cosine similarity of each model word to these DDRs.
Specifically, I compute cosine similarity between the Macho and Nice DDRs and only the words in the model that have valence scores—i.e., those appearing in Warriner.
(Warriner contains ~14,000 words with valence. After this examination, I repeat the analysis with the trait list—i.e., restricting to words that appear in both Warriner and the trait list.)
warriner_with_COSINE_from_DDR <- list()
# Switching to dfm - in order to change to ds4psych workflow to make which word a feature
# in order to do so lets switch it to corpus :
warriner_corpus <- warriner |>
corpus(
text_field = "word",
docid_field ="id")
# REMEMBER the corpus those have valence in it !
warriner_dfm <- warriner_corpus |>
tokens() |>
dfm()
# now that we have dfm we can use get_sims()
for (i in seq_along(ENGall_model)) {
warriner_with_COSINE_from_DDR[[i]] <- warriner_dfm|>
# Getting the embedding of the Warriner words by ENGallL:
textstat_embedding(to_embeddings(ENGall_model[[i]])) |>
bind_cols(docvars(warriner_corpus)) |>
# Getting the Cosine_squish form Macho with nudge (remeber that its a list by decades so add [[i]])
get_sims(
V1:V300,
list(
macho_nudge = Macho_DDR_nudge_by_decade[[i]],
macho_inject = Macho_DDR_injected_by_decade[[i]],
nice_nudge = Nice_DDR_nudge_by_decade[[i]],
nice_inject = Nice_DDR_injected_by_decade[[i]]
),
method = "cosine_squished"
) |>
# adding the word for the results to be readable
left_join(warriner |> select(word,id),
by= c("doc_id" ="id"))
}
names(warriner_with_COSINE_from_DDR) <- decades
#-------- NOTICE! ------
# Before the comparisons I'll omit the words that were used to create the DDR, namely, macho_guy_word and nice_guy_words, to reduce noise .
# a sanity check has reviled that the those words received higher cos sim (DUH!)
warriner_COSINE_DDR_omit<- list()
for (i in seq_along(warriner_with_COSINE_from_DDR)) {
warriner_COSINE_DDR_omit[[i]]<- warriner_with_COSINE_from_DDR[[i]] |>
filter(!word %in% c(macho_guy_words, nice_guy_words))
}
names(warriner_COSINE_DDR_omit) <- decades
#Exporting files for inspection
# for (i in seq_along(warriner_with_COSINE_from_DDR)) {
#
# write_csv(
# warriner_COSINE_DDR_omit[[i]],
# file = paste("csv/",paste(decades[i],"decade.csv"))
# )
# }2.2 Deltas
#Helper - Comparison:
compare_DDRs<- function(df) {
df |>
mutate(
# Nudge
delta_nudge = macho_nudge - nice_nudge,
# Inject
delta_inject = macho_inject - nice_inject,
)
}
# Adding the variables to the list
warriner_COSINE_DDR_Diff <- list()
for (i in seq_along(warriner_COSINE_DDR_omit)) {
warriner_COSINE_DDR_Diff[[i]]<- compare_DDRs(warriner_COSINE_DDR_omit[[i]])
}
names(warriner_COSINE_DDR_Diff) <- decades
# Make it a long format for it to be easier to work with :
bind_with_decade <- function(dflist) {
tibble(
decade = names(dflist),
df = dflist
) |>
mutate(df = map2(df, decade, ~ .x |>
mutate(decade = .y))) |>
pull(df) |>
bind_rows()
}
raw_long <- bind_with_decade(warriner_COSINE_DDR_Diff) |>
mutate(
# Make `decade` an ordered factor (sorted numerically)
decade = factor(decade, levels = sort(unique(as.integer(decade))) |> as.character())
) 2.2.1 —- Q1 ——
Is there, overall, a difference in association across 200 years between Macho and Nice Guy for these word lists?
tt <- t.test(raw_long$macho_nudge,raw_long$nice_nudge,alternative = "two.sided")
if(tt$p.value < 0.05) {
print("Q1 - supports of H1")
} else {
print("Q1 - supports of H0")
}[1] "Q1 - supports of H1"
compare_nice_macho_words <- function (data, only_traits =F){
#removing NA by delta_nudge
data <- data |>
filter(!is.na(delta_nudge)) |>
mutate(doc_id = factor(doc_id))
# Checking id the comparison is done by traits only or all the words
if(only_traits){
data <- data |> filter(doc_id %in% (traits_warriner |>
select(id) |>
pull()))
}
data |>
# THIS FUNCTION IS AT WORD LEVEL NOT DECADE!
group_by(doc_id) |>
summarise(
n = n(),
# Mean
mean_delta_nudge = mean(delta_nudge, na.rm =T ),
mean_delta_inject = mean(delta_inject, na.rm =T ),
# SD
sd_nudge = sd(delta_nudge, na.rm =T),
sd_inject = sd(delta_inject, na.rm =T),
# SE
se_nudge = sd_nudge / sqrt(n),
se_inject = sd_inject / sqrt(n),
# T
t_nudge = ifelse(n > 1,
mean_delta_nudge / se_nudge,
NA_real_),
t_inject = ifelse(n > 1,
mean_delta_inject / se_inject,
NA_real_),
df = n - 1L,
# P values
p_t_nudge = ifelse(n > 1,
2 * pt(-abs(t_nudge), df),
NA_real_),
p_t_inject = ifelse(n > 1,
2 * pt(-abs(t_inject), df),
NA_real_),
#Cohen's D: mean of Δ divided by SD of Δ
d_z_nudge = mean_delta_nudge / sd_nudge,
d_z_inject = mean_delta_inject / sd_inject,
# Confidence intervals
ci_low_nudge = ifelse(n > 1,
mean_delta_nudge + qt(0.025, df) * se_nudge,
NA_real_),
ci_high_nudge = ifelse(n > 1,
mean_delta_nudge + qt(0.975, df) * se_nudge,
NA_real_),
ci_low_inject = ifelse(n > 1,
mean_delta_inject + qt(0.025, df) * se_inject,
NA_real_),
ci_high_inject = ifelse(n > 1,
mean_delta_inject + qt(0.975, df) * se_inject,
NA_real_),
# Significance
sign_nudge = case_when(
p_t_nudge < 0.001 ~ "***",
p_t_nudge < 0.01 ~ "**",
p_t_nudge < 0.05 ~ "*",
TRUE ~ "No"
),
sign_inject = case_when(
p_t_inject < 0.001 ~ "***",
p_t_inject < 0.01 ~ "**",
p_t_inject < 0.05 ~ "*",
TRUE ~ "No"
),
.groups = "drop"
) |>
left_join(raw_long |> select(doc_id,
word,
valence),
by= "doc_id")|>
# Staying on word level - row = words
distinct()
}
####----- GENERAL COMPARISON -----
# NOTE: This we aren't not with the function because the grouping here is done by decade and not word:
summ_t_wtnin_dcds_overall <- raw_long|>
#removing na by delta_nudge
filter(!is.na(delta_nudge)) |>
group_by(decade)|>
summarise(
n = n(),
# Mean
mean_delta_nudge = mean(delta_nudge, na.rm =T ),
mean_delta_inject = mean(delta_inject, na.rm =T ),
# SD
sd_nudge = sd(delta_nudge, na.rm =T),
sd_inject = sd(delta_inject, na.rm =T),
# SE
se_nudge = sd_nudge / sqrt(n),
se_inject = sd_inject / sqrt(n),
# T
t_nudge = ifelse(n > 1,
mean_delta_nudge / se_nudge,
NA_real_),
t_inject = ifelse(n > 1,
mean_delta_inject / se_inject,
NA_real_),
df = n - 1L,
# P values
p_t_nudge = ifelse(n > 1,
2 * pt(-abs(t_nudge), df),
NA_real_),
p_t_inject = ifelse(n > 1,
2 * pt(-abs(t_inject), df),
NA_real_),
#Cohen's D: mean of Δ divided by SD of Δ
d_z_nudge = mean_delta_nudge / sd_nudge,
d_z_inject = mean_delta_inject / sd_inject,
# Confidence intervals
ci_low_nudge = ifelse(n > 1,
mean_delta_nudge + qt(0.025, df) * se_nudge,
NA_real_),
ci_high_nudge = ifelse(n > 1,
mean_delta_nudge + qt(0.975, df) * se_nudge,
NA_real_),
ci_low_inject = ifelse(n > 1,
mean_delta_inject + qt(0.025, df) * se_inject,
NA_real_),
ci_high_inject = ifelse(n > 1,
mean_delta_inject + qt(0.975, df) * se_inject,
NA_real_),
# Significance
sign_nudge = case_when(
p_t_nudge < 0.001 ~ "***",
p_t_nudge < 0.01 ~ "**",
p_t_nudge < 0.05 ~ "*",
TRUE ~ "No"
),
sign_inject = case_when(
p_t_inject < 0.001 ~ "***",
p_t_inject < 0.01 ~ "**",
p_t_inject < 0.05 ~ "*",
TRUE ~ "No"
),
.groups = "drop"
)
summ_t_inject <- summ_t_wtnin_dcds_overall |>
select(-contains("_nudge"))
# NOT SIGNIFICANT - 1870
summ_t_nudge <- summ_t_wtnin_dcds_overall |>
select(-contains("_inject"))
# NOT SIGNIFICANT - 1980kable (summ_t_wtnin_dcds_overall |> select(decade,
sign_nudge,
sign_inject,
p_t_nudge,
p_t_inject),
caption = "Significance test of the constructs throught the decades")| decade | sign_nudge | sign_inject | p_t_nudge | p_t_inject |
|---|---|---|---|---|
| 1800 | *** | ** | 0.0000000 | 0.0017251 |
| 1810 | *** | ** | 0.0000000 | 0.0043208 |
| 1820 | *** | *** | 0.0000000 | 0.0000005 |
| 1830 | *** | *** | 0.0000000 | 0.0000005 |
| 1840 | *** | *** | 0.0000000 | 0.0000000 |
| 1850 | *** | *** | 0.0000000 | 0.0000000 |
| 1860 | *** | *** | 0.0000000 | 0.0000000 |
| 1870 | ** | No | 0.0029673 | 0.6178121 |
| 1880 | *** | *** | 0.0000000 | 0.0000181 |
| 1890 | *** | *** | 0.0000000 | 0.0000000 |
| 1900 | *** | *** | 0.0000000 | 0.0000128 |
| 1910 | *** | ** | 0.0000000 | 0.0081183 |
| 1920 | *** | *** | 0.0000000 | 0.0000000 |
| 1930 | *** | ** | 0.0000000 | 0.0024509 |
| 1940 | *** | *** | 0.0000000 | 0.0000000 |
| 1950 | *** | *** | 0.0000000 | 0.0000000 |
| 1960 | *** | *** | 0.0000000 | 0.0000000 |
| 1970 | *** | *** | 0.0000000 | 0.0000000 |
| 1980 | No | * | 0.0945198 | 0.0406543 |
| 1990 | ** | *** | 0.0053125 | 0.0000000 |
Overall, in most decades and across both DDR techniques, there is a significant difference in the association of words with Macho versus Nice. This mainly serves as a validation that our two constructs capture distinct semantics.
2.2.2 —- Q2——-
Across all decades, which words or traits are most associated with each DDR (testing significance once overall)?
words_t_summ<- compare_nice_macho_words (raw_long)
## ------ Top 20 Words------
### ----- Macho --------------
top_20_words_macho_nudge_overall <- words_t_summ |>
# Sign only
filter(!sign_nudge == "No") |>
# arranging to but the standardized delta across decades
arrange(
desc(d_z_nudge)
) |>
# fetching the to 20
slice_head(n = 20)
top_20_words_macho_inject_overall <- words_t_summ |>
# Sign only
filter(!sign_inject == "No") |>
# arranging to but the standardized delta across decades
arrange(
desc(d_z_inject)
) |>
# fetching the to 20
slice_head(n = 20)
### ----- Nice --------------
top_20_words_nice_nudge_overall <- words_t_summ |>
# Sign only
filter(!sign_nudge == "No") |>
# arranging to but the standardized delta across decades
arrange(
# Notice this Time I want to get the lowest (minus) since delta is macho minus nice negative value indicate stronger association toward nice
d_z_nudge
) |>
# fetching the to 20
slice_head(n = 20)
top_20_words_nice_inject_overall <- words_t_summ |>
# Sign only
filter(!sign_inject == "No") |>
# arranging to but the standardized delta across decades
arrange(
# Notice this Time I want to get the lowest (minus) since delta is macho minus nice negative value indicate stronger association toward nice
d_z_inject
) |>
# fetching the to 20
slice_head(n = 20) # A tibble: 20 × 23
doc_id n mean_delta_nudge mean_delta_inject sd_nudge sd_inject se_nudge
<chr> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
1 13133 2 -0.0113 -0.0145 0.0000819 0.00128 0.0000579
2 1545 2 -0.0333 -0.0415 0.000272 0.00205 0.000192
3 10675 2 -0.0223 -0.0282 0.000388 0.000498 0.000275
4 7969 2 -0.0260 -0.0339 0.000782 0.000947 0.000553
5 7228 2 -0.0235 -0.0252 0.00168 0.00381 0.00119
6 10874 2 -0.0101 -0.00562 0.000743 0.00497 0.000526
7 2879 2 -0.0278 -0.0364 0.00229 0.00600 0.00162
8 13714 2 -0.0267 -0.0322 0.00255 0.00319 0.00180
9 6440 3 -0.0615 -0.0801 0.00596 0.00617 0.00344
10 8279 3 -0.0357 -0.0431 0.00360 0.00502 0.00208
11 11034 2 -0.0262 -0.0323 0.00270 0.00534 0.00191
12 2815 20 -0.140 -0.157 0.0145 0.0147 0.00324
13 3920 2 -0.0634 -0.0732 0.00665 0.00710 0.00470
14 6823 20 -0.132 -0.161 0.0140 0.0172 0.00314
15 11059 4 -0.0512 -0.0534 0.00545 0.00533 0.00273
16 1026 2 -0.00787 -0.00954 0.000853 0.00495 0.000603
17 4854 2 -0.0175 -0.0146 0.00190 0.000189 0.00135
18 5693 20 -0.0904 -0.0919 0.00993 0.0109 0.00222
19 11197 20 -0.125 -0.142 0.0140 0.0169 0.00313
20 5136 20 -0.106 -0.113 0.0125 0.0224 0.00281
# ℹ 16 more variables: se_inject <dbl>, t_nudge <dbl>, t_inject <dbl>,
# df <int>, p_t_nudge <dbl>, p_t_inject <dbl>, d_z_nudge <dbl>,
# d_z_inject <dbl>, ci_low_nudge <dbl>, ci_high_nudge <dbl>,
# ci_low_inject <dbl>, ci_high_inject <dbl>, sign_nudge <chr>,
# sign_inject <chr>, word <chr>, valence <dbl>
macho_table_all_words_fig| cohenD_inject | words_inject | cohenD_nudge | word_nudge | rank |
|---|---|---|---|---|
| 255.456 | launcher | 129.888 | outwit | 1 |
| 106.013 | striker | 82.791 | launcher | 2 |
| 50.104 | safari | 72.212 | safari | 3 |
| 40.676 | celibate | 40.461 | striker | 4 |
| 39.298 | outwit | 32.563 | info | 5 |
| 24.180 | eggshell | 30.688 | panda | 6 |
| 20.513 | midlife | 26.554 | jumper | 7 |
| 17.765 | superpower | 23.781 | superpower | 8 |
| 17.193 | payload | 22.951 | eggshell | 9 |
| 15.832 | gloat | 21.065 | tarmac | 10 |
| 15.792 | temp | 19.816 | midlife | 1 |
| 14.260 | neutron | 15.724 | chic | 2 |
| 13.823 | swank | 15.605 | crossover | 3 |
| 13.449 | anemic | 15.191 | celibate | 4 |
| 13.341 | panda | 14.990 | gloat | 5 |
| 12.716 | perm | 14.817 | neutron | 6 |
| 11.592 | tarmac | 14.147 | perm | 7 |
| 11.590 | freckle | 12.591 | anemic | 8 |
| 10.637 | commando | 12.475 | rhino | 9 |
| 10.459 | keypad | 11.662 | commando | 10 |
nice_table_all_words_fig| cohenD_inject | words_inject | cohenD_nudge | word_nudge | rank |
|---|---|---|---|---|
| -77.261 | forevermore | -137.490 | unlisted | 1 |
| -56.663 | sauerkraut | -122.791 | bubbly | 2 |
| -35.783 | mozzarella | -57.336 | sauerkraut | 3 |
| -27.431 | doornail | -33.173 | mozzarella | 4 |
| -20.252 | bubbly | -13.963 | lopsided | 5 |
| -12.978 | insightful | -13.559 | seedy | 6 |
| -11.348 | unlisted | -12.153 | creamed | 7 |
| -10.708 | courteous | -10.474 | wiggle | 8 |
| -10.309 | easygoing | -10.313 | insightful | 9 |
| -10.081 | wiggle | -9.909 | nuance | 10 |
| -10.015 | shit | -9.702 | sherbet | 1 |
| -9.318 | kindness | -9.666 | courteous | 2 |
| -8.584 | nuance | -9.533 | easygoing | 3 |
| -8.427 | sincere | -9.431 | kindness | 4 |
| -8.421 | hearted | -9.396 | shit | 5 |
| -8.270 | grateful | -9.219 | beep | 6 |
| -7.894 | affection | -9.173 | forevermore | 7 |
| -7.874 | compassion | -9.104 | hearted | 8 |
| -7.777 | remembrance | -8.940 | sincere | 9 |
| -7.709 | agreeable | -8.434 | generous | 10 |
Thought. We should consider an inclusion criterion that retains only words appearing in ≥ ~5 decades, since many “Top-20” items occur in only a few decades.
table(top_20_words_nice_nudge_overall$n)
2 3 4 20
12 2 1 5
# [1] 2 || 3 || 4 || 20
# [2] 12|| 2 || 1 || 5
table(top_20_words_macho_nudge_overall$n)
2 3 7
15 4 1
# [1] 2 || 3 || 7
# [2]15 || 4 || 1 For traits, there are two options:
Run the statistical test on the
traits_warrinerdata frame so that the SD is calculated from trait-level deltas; orFilter
words_t_summto only those intraits_warriner, which computes SD over the entire word list.
Option (1) seems preferable.
Note: In warriner_COSINE_DDR_omit we removed the terms used to create the DDRs, so none of those (macho_guy_words / nice_guy_words) should appear in the trait list.
## ------ Top 10 traits------
traits_t_summ<- compare_nice_macho_words(raw_long,only_traits = T)
#### ------ Macho -------
top_10_traits_macho_nudge_overall <- traits_t_summ |>
# Sign only
filter(!sign_nudge == "No") |>
# arranging to but the standardized delta across decades
arrange(
desc(d_z_nudge)
) |>
# fetching the top 10
slice_head(n = 10) |>
mutate(rank = row_number())
top_10_traits_macho_inject_overall <- traits_t_summ |>
# Sign only
filter(!sign_inject == "No") |>
# arranging to but the standardized delta across decades
arrange(
desc(d_z_inject)
) |>
# fetching the top 10
slice_head(n = 10) |>
mutate(rank = row_number())
### ----- Nice --------------
top_10_traits_nice_nudge_overall <- traits_t_summ |>
# Sign only
filter(!sign_nudge == "No") |>
# arranging to but the standardized delta across decades
arrange(
# Notice this Time I want to get the lowest (minus) since delta is macho minus nice negative value indicate stronger association toward nice
d_z_nudge
) |>
# fetching the to 20
slice_head(n = 10) |>
mutate(rank = row_number())
top_10_traits_nice_inject_overall <- traits_t_summ |>
# Sign only
filter(!sign_inject == "No") |>
# arranging to but the standardized delta across decades
arrange(
# Notice this Time I want to get the lowest (minus) since delta is macho minus nice negative value indicate stronger association toward nice
d_z_inject
) |>
# fetching the top 10
slice_head(n = 10) |>
mutate(rank = row_number())Insight. The “small n” problem (traits appearing in only a few decade models) is less severe here; most traits appear more than 10 times overall across models.
### ---- Tabling-----
nice_table_all<- data.frame(
cohenD_inject = top_10_traits_nice_inject_overall$d_z_inject,
words_inject = top_10_traits_nice_inject_overall$word,
cohenD_nudge = top_10_traits_nice_nudge_overall$d_z_nudge,
word_nudge = top_10_traits_nice_nudge_overall$word,
rank= c(1:10)
)
nice_all_traits_table<- kable(
nice_table_all,
caption = "Top 10 Nice (vs. Macho) Traits",
digits = 3
)
macho_table_all<- data.frame(
cohenD_inject = top_10_traits_macho_inject_overall$d_z_inject,
words_inject = top_10_traits_macho_inject_overall$word,
cohenD_nudge = top_10_traits_macho_nudge_overall$d_z_nudge,
word_nudge = top_10_traits_macho_nudge_overall$word,
rank= c(1:10)
)
macho_table_all_table<- kable(
macho_table_all,
caption = "Top 10 Macho (vs. Nice) Traits",
digits = 3
)macho_table_all_table| cohenD_inject | words_inject | cohenD_nudge | word_nudge | rank |
|---|---|---|---|---|
| 4.886 | conservative | 3.935 | enterprising | 1 |
| 4.358 | manipulative | 3.771 | conservative | 2 |
| 3.811 | active | 3.359 | defensive | 3 |
| 3.663 | enterprising | 3.165 | manipulative | 4 |
| 3.394 | defensive | 3.031 | indecisive | 5 |
| 3.364 | forceful | 2.787 | ruthless | 6 |
| 3.177 | brilliant | 2.774 | belligerent | 7 |
| 3.158 | weak | 2.543 | brilliant | 8 |
| 3.150 | indecisive | 2.502 | objective | 9 |
| 3.123 | energetic | 2.493 | forceful | 10 |
nice_all_traits_table| cohenD_inject | words_inject | cohenD_nudge | word_nudge | rank |
|---|---|---|---|---|
| -12.978 | insightful | -10.313 | insightful | 1 |
| -10.708 | courteous | -9.666 | courteous | 2 |
| -10.309 | easygoing | -9.533 | easygoing | 3 |
| -8.427 | sincere | -8.940 | sincere | 4 |
| -7.709 | agreeable | -8.434 | generous | 5 |
| -7.022 | friendly | -6.955 | agreeable | 6 |
| -6.485 | gracious | -6.732 | friendly | 7 |
| -5.744 | pleasant | -6.718 | gracious | 8 |
| -5.698 | compassionate | -6.696 | patient | 9 |
| -5.543 | patient | -6.659 | helpful | 10 |
2.2.3 —- Q3 —-
Over time, does the valence of the words/traits most associated with one construct (vs. the other) change?
For each decade, I identify the Top-10 most related words and compute their mean valence.
To make interpretation more intuitive, I rescale valence from the original range to −4…+4, where negative values indicate negative valence and positive values indicate, well, positive valence.
# --------- WITHIN DECADES------------
#----- Q3 ----
get_top_valence <- function(data,
decade,
is.nudge= F,
only_traits = F,
macho_vs = T) {
# Words or Traits ?
if(only_traits){
data <- data |> filter(doc_id %in% (traits_warriner |>
select(id) |>
pull()))
}
# Nudge or Inject
col <- if (is.nudge) "delta_nudge" else "delta_inject"
# If macho_vs is False meaning we want the words that are more associated to nice (vs macho) therefore assenting order of delta since delta is macho MINUS nice
dir <- if (macho_vs) -1 else 1
data <- data[order(dir * data[[col]]), ]
data |>
slice_head(n = 10) |>
summarise(
mean_valence = mean(valence, na.rm = TRUE),
decade = as.numeric(decade)
)
}
# the list of 20 df with deltas: warriner_COSINE_DDR_Diff
### ------- Macho ------
# Words Inject
valence_words_macho_decades_inject<- map2_dfr(
warriner_COSINE_DDR_Diff, decades,
~ get_top_valence(.x,
decade = .y)
)|>
mutate(mean_valence = mean_valence -4)
# Words Nudge
valence_words_macho_decades_nudge <- map2_dfr(
warriner_COSINE_DDR_Diff,
decades,
~ get_top_valence(.x,
decade = .y,
is.nudge = TRUE)
) |>
mutate(mean_valence = mean_valence -4)
# Traits Inject
valence_traits_macho_decades_inject <- map2_dfr(
warriner_COSINE_DDR_Diff,
decades,
~ get_top_valence(.x,
decade = .y,
only_traits = TRUE)
) |>
mutate(mean_valence = mean_valence -4)
# Traits nudge
valence_traits_macho_decades_nudge <- map2_dfr(
warriner_COSINE_DDR_Diff,
decades,
~ get_top_valence(.x,
decade = .y,
only_traits = TRUE,
is.nudge = TRUE)
) |>
mutate(mean_valence = mean_valence -4)
## -------- Nice
# Words Inject
valence_words_nice_decades_inject<- map2_dfr(
warriner_COSINE_DDR_Diff, decades,
~ get_top_valence(.x,
decade = .y,
macho_vs = F)
) |>
mutate(mean_valence = mean_valence -4)
# Words Nudge
valence_words_nice_decades_nudge <- map2_dfr(
warriner_COSINE_DDR_Diff,
decades,
~ get_top_valence(.x,
decade = .y,
is.nudge = TRUE,
macho_vs = F)
) |>
mutate(mean_valence = mean_valence -4)
# Traits Inject
valence_traits_nice_decades_inject <- map2_dfr(
warriner_COSINE_DDR_Diff,
decades,
~ get_top_valence(.x,
decade = .y,
only_traits = TRUE,
macho_vs = F)
) |>
mutate(mean_valence = mean_valence -4)
# Traits nudge
valence_traits_nice_decades_nudge <- map2_dfr(
warriner_COSINE_DDR_Diff,
decades,
~ get_top_valence(.x,
decade = .y,
only_traits = TRUE,
is.nudge = TRUE,
macho_vs = F)
) |>
mutate(mean_valence = mean_valence -4)
# ----- Modeling Macho ----
# Word inject - Macho
lm_macho_words_inject <- lm(mean_valence ~ decade, data = valence_words_macho_decades_inject)
# Word nudge - Macho
lm_macho_words_nudge <- lm(mean_valence ~ decade, data = valence_words_macho_decades_nudge)
# Trait inject - Macho
lm_macho_traits_inject <- lm(mean_valence ~ decade, data = valence_traits_macho_decades_inject)
# Trait nudge - Macho
lm_macho_traits_nudge <- lm(mean_valence ~ decade, data = valence_traits_macho_decades_nudge)
# --------- Modeling Nice --------
# Word inject - Nice
lm_nice_words_inject <- lm(mean_valence ~ decade, data = valence_words_nice_decades_inject)
# Word nudge - Nice
lm_nice_words_nudge <- lm(mean_valence ~ decade, data = valence_words_nice_decades_nudge)
# Trait inject - Nice
lm_nice_traits_inject <- lm(mean_valence ~ decade, data = valence_traits_nice_decades_inject)
# Trait nudge -Nice
lm_nice_traits_nudge <- lm(mean_valence ~ decade, data = valence_traits_nice_decades_nudge)#Attractiveness In this section, I constructed a decade-specific Attractiveness DDRs and then examine how semantically close the macho and nice representations are to attractiveness across time.
The goal is to quantify how the semantic association between Masochistic and gentle masculinity and attractiveness has shifted across historical decades.
2.3 Word list
We begin by specifying a set of core adjectives that directly express attractiveness (e.g., attractive, beautiful, handsome, sexy, etc.). Two versions are created:
Nudge version: uses only the attractiveness descriptors.
Inject version: includes the attractiveness descriptors plus the male anchor words, ensuring a stronger masculine reference frame in the embedding space.
This parallels the earlier (Macho/Nice) pipeline for consistency.
attractiveness_words <- c(
"attractive",
"beautiful",
"handsome",
"gorgeous",
"pretty",
"sexy",
"cute",
"alluring",
"charming",
"appealing"
)
# injected
attractiveness_words_injected <- attractiveness_words|>
c(male_anchors)For each historical decade represented in the ENGall embedding model, we compute an Attractiveness DDR using the same procedure applied previously to Macho and Nice:
Inject condition
- Retrieve the embeddings of all attractiveness words + male anchors.
- Compute their average embedding, yielding the Attractiveness Injected DDR for that decade.
Nudge condition
- Retrieve the embeddings of the attractiveness adjectives.
- Average them to obtain the raw Attractiveness Nudge DDR.
- Apply the
masculinity_nudge()transformation to align the DDR with the nudge paradigm used for the Macho/Nice DDRs
Each DDR represents a single semantic vector summarizing the meaning of attractiveness in that decade.
# ---- setting the ENGall model to fit 'embedplyr' workflow
## ----------- Attractiveness DDR (with injection) ----------
Attractiveness_DDR_injected_by_decade <- list()
for (i in seq_along(ENGall_model)) {
Attractiveness_DDR_injected_by_decade[[i]] <- predict(to_embeddings(ENGall_model[[i]]), attractiveness_words_injected)|>
average_embedding()
}
names(Attractiveness_DDR_injected_by_decade) <- decades
## ----------- Attractiveness DDR Nudge ----------
Attractiveness_DDR_nudge_by_decade <- list()
for (i in seq_along(ENGall_model)) {
Attractiveness_DDR_nudge_by_decade[[i]] <- predict(to_embeddings(ENGall_model[[i]]), attractiveness_words)|>
average_embedding() |>
masculinity_nudge(E = ENGall_model[[i]])
}
names(Attractiveness_DDR_nudge_by_decade) <- decades2.4 Cosine Similarity from Attractiveness DDRs
# Helper function to compute cosine similarity from Attractiveness DDRs
# -------------------------------
# Helper: pure cosine similarity
# -------------------------------
cosine_sim <- function(v1, v2) {
sum(v1 * v2) / (sqrt(sum(v1^2)) * sqrt(sum(v2^2)))
}
# List to store results
cosine_from_attractiveness_nudge <- list()
cosine_from_attractiveness_inject <- list()
for (i in seq_along(ENGall_model)) {
# computing the Cosim - using the built in function textSimilarity(v1, v2)
# Nudge:
cosine_from_attractiveness_nudge[[i]] <- data.frame(
sims_macho_attract=cosine_sim(Macho_DDR_nudge_by_decade[[i]],Attractiveness_DDR_nudge_by_decade[[i]]),
sims_nice_attract=
cosine_sim(Nice_DDR_nudge_by_decade[[i]],
Attractiveness_DDR_nudge_by_decade[[i]]),
i_decade= i
)
# Inject:
cosine_from_attractiveness_inject[[i]] <- data.frame(
sims_macho_attract=cosine_sim(Macho_DDR_injected_by_decade[[i]],Attractiveness_DDR_injected_by_decade[[i]]),
sims_nice_attract=cosine_sim(Nice_DDR_injected_by_decade[[i]],
Attractiveness_DDR_injected_by_decade[[i]]),
i_decade= i
)
}
names(cosine_from_attractiveness_nudge) <- decades
names(cosine_from_attractiveness_inject) <- decades# Binding the results into a data frame for plotting
cosine_attract_nudge_df <- bind_rows(cosine_from_attractiveness_nudge) |>
mutate(
decade = decades[i_decade]
) |>
select(-i_decade)
cosine_attract_inject_df <- bind_rows(cosine_from_attractiveness_inject) |>
mutate(
decade = decades[i_decade]
) |>
select(-i_decade)
#write a ggplot to show the results
# Nudge plot
nudge_attr_plot <- ggplot(cosine_attract_nudge_df, aes(x = decade)) +
geom_line(aes(y = sims_macho_attract, color = "Macho")) +
geom_line(aes(y = sims_nice_attract, color = "Nice")) +
labs(
title = "Cosine Similarity from Attractiveness DDR (Nudge)",
x = "Decade",
y = "Cosine Similarity",
color = "Construct"
) +
theme_minimal()
# Inject plot
inject_attr_plot <- ggplot(cosine_attract_inject_df, aes(x = decade)) +
geom_line(aes(y = sims_macho_attract, color = "Macho")) +
geom_line(aes(y = sims_nice_attract, color = "Nice")) +
labs(
title = "Cosine Similarity from Attractiveness DDR (Inject)",
x = "Decade",
y = "Cosine Similarity",
color = "Construct"
) +
theme_minimal()# Nudge t-test
tt_nudge <- t.test(cosine_attract_nudge_df$sims_macho_attract,
cosine_attract_nudge_df$sims_nice_attract,
alternative = "two.sided")
if(tt_nudge$p.value < 0.05) {
print("Attractiveness Nudge - supports of H1")
} else {
print("Attractiveness Nudge - supports of H0")
}[1] "Attractiveness Nudge - supports of H1"
# Inject t-test
tt_inject <- t.test(cosine_attract_inject_df$sims_macho_attract,
cosine_attract_inject_df$sims_nice_attract,
alternative = "two.sided")
if(tt_inject$p.value < 0.05) {
print("Attractiveness Inject - supports of H1")
} else {
print("Attractiveness Inject - supports of H0")
}[1] "Attractiveness Inject - supports of H1"
# show the resultin apa table
attractiveness_cosim_table <- data.frame(
DDR_Type = c("Nudge", "Inject"),
t_value = c(tt_nudge$statistic, tt_inject$statistic),
df = c(tt_nudge$parameter, tt_inject$parameter),
p_value = c(tt_nudge$p.value, tt_inject$p.value),
mean_macho_cosim = c(mean(cosine_attract_nudge_df$sims_macho_attract),
mean(cosine_attract_inject_df$sims_macho_attract)),
mean_nice_cosim = c(mean(cosine_attract_nudge_df$sims_nice_attract),
mean(cosine_attract_inject_df$sims_nice_attract))
)
kable(
attractiveness_cosim_table,
caption = "T-test results for Cosine Similarity from Attractiveness DDR",
digits = 3
)| DDR_Type | t_value | df | p_value | mean_macho_cosim | mean_nice_cosim |
|---|---|---|---|---|---|
| Nudge | -2.099 | 34.721 | 0.043 | 0.606 | 0.647 |
| Inject | -5.103 | 35.973 | 0.000 | 0.482 | 0.581 |
Across decades, the Nice DDR was consistently more semantically associated with attractiveness than the Macho DDR. In the nudge condition, Nice DDRs showed significantly higher cosine similarity to attractiveness than Macho DDRs, t(34.72) = −2.10, p = .043 (M_nice = .647, M_macho = .606). This pattern was even stronger in the inject condition, where Nice DDRs again exhibited greater proximity to attractiveness, t(35.97) = −5.10, p < .001 (M_nice = .581, M_macho = .482).
Together, these results indicate that across historical decades, the semantic space positions “nice” traits closer to attractiveness than “macho” traits, under both nudge and inject paradigms.